home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Stretching the Mind / Modulated gen-feigenbaum < prev    next >
Lisp/Scheme  |  1998-10-26  |  4KB  |  101 lines
  1. ; modulated feigenbaum
  2.  
  3. ; The following redefines gen-feigenbaum to accept additional vector whose
  4. ; values are mixed to the feigenbaum calculation. This enables to get
  5. ; less obvious output which still belongs into the feigenbaum catagory.
  6.  
  7. (defun gen-feigenbaum (r iter add xinit &optional (v #(0)) (pos 0))
  8.   (let* ((outv (make-array iter)) 
  9.          (x xinit) 
  10.          (vmax (length v)))
  11.     (dotimes (i iter)
  12.       (setq x (* r x (- 1.0 x)))
  13.       (setq x (+ x (aref v (mod (+ pos i) vmax))))
  14.       (putv outv i x)
  15.       (setq r (+ r add)))
  16.     outv))
  17.  
  18. (setq fibmod 
  19.    (vector-scale -0.15 0.15 
  20.        (list-to-vector 
  21.           (gen-fibonacci-trans 9 '(1 2 3) '(4 5 6)))))
  22.  
  23. ;
  24.  
  25. (def-orchestra 'orchestra
  26.    all-instruments (piano)
  27. )
  28.  
  29. ; each of these symbols sound different, evaluate one of them manually and
  30. ; then continue evaluating the rest of the score to hear them
  31.  
  32. (setq symbols
  33.       (vector-to-symbol a g (gen-feigenbaum 3.60 256 -0.001 0.1 fibmod 0)))
  34.  
  35. (setq symbols
  36.    (vector-to-symbol a g (gen-feigenbaum 3.60 256 -0.001 0.1 (vector-scale -0.04 0.04 (gen-feigenbaum 2.651 64 0.02 0.1)))))
  37.  
  38. (setq symbols
  39.    (vector-to-symbol a k (gen-feigenbaum 3.60 256 -0.002 0.1 (vector-scale -0.04 0.04 (gen-feigenbaum 2.651 64 0.02 0.1)))))
  40.  
  41. (setq symbols
  42.       (vector-to-symbol a k (gen-feigenbaum 1.160 256 0.0114 0.1 
  43.                                             (vector-scale -0.03 0.07 (gen-feigenbaum 2.623 8 0.005 0.999))
  44.                                             4)))
  45.  
  46. (setq symbols
  47.       (vector-to-symbol a k (gen-feigenbaum 1.160 256 0.0114 0.1 
  48.                                             (vector-scale -0.03 0.03 (gen-feigenbaum 2.623 4 0.005 0.999))
  49.                                             3)))
  50.  
  51. (setq symbols
  52.       (vector-to-symbol a k (gen-feigenbaum 2.460 256 0.00114 0.01 
  53.                                             (vector-scale -0.03 0.03 #(1 2 3 4))
  54.                                             3)))
  55.  
  56. (setq symbols
  57.       (vector-to-symbol a h (gen-feigenbaum 2.460 256 0.002114 0.01 
  58.                                             (vector-scale -0.03 0.03 #(1 2 3 4))
  59.                                             3)))
  60.  
  61. (setq symbols
  62.       (vector-to-symbol a h (gen-feigenbaum 2.460 256 0.003414 0.13 
  63.                                             (vector-scale -0.03 0.03 #(1 2 3 4))
  64.                                             3)))
  65.  
  66. (setq symbols
  67.       (vector-to-symbol a h (gen-feigenbaum 2.460 256 0.003414 0.13 
  68.                                             (vector-scale -0.03 0.03 #(1 2 3 4))
  69.                                             3)))
  70.  
  71. (setq symbols
  72.       (vector-to-symbol a h (gen-feigenbaum 2.460 256 0.003414 0.13 
  73.                                             (vector-scale -0.03 0.03 #(1 2 3 4))
  74.                                             4)))
  75.  
  76. (setq symbols
  77.       (vector-to-symbol a h (gen-feigenbaum 2.460 450 0.003414 0.13 
  78.                                             (vector-scale -0.02 0.02 #(1 2 3 4))
  79.                                             3)))
  80.  
  81. (setq symbols
  82.       (vector-to-symbol a p (gen-feigenbaum 2.460 450 0.003414 0.13 
  83.                                             (vector-scale -0.03 0.02 #(1 2 3 4))
  84.                                             5)))
  85.  
  86. (def-section sect-a
  87.    default
  88.       zone (lsym-correct (* (length symbols) (get-ratio '1/16 :ratio)))
  89.       tonality (activate-tonality (pentatonic c 4))
  90.       length '(1/16)
  91.       velocity '(64)
  92.    piano
  93.       symbol symbols 
  94. )
  95.  
  96. (midiport :printer)
  97.  
  98. (play-file-p "my song"
  99.    all-instruments '(sect-a)
  100. )
  101.